home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Panorama / Panorama - Disk 25A (1988-01-13)(Pacific North-West Amigas Club)[WB].zip / Panorama - Disk 25A (1988-01-13)(Pacific North-West Amigas Club)[WB].adf / CLI / Select / select.mod < prev   
Text File  |  1988-01-01  |  5KB  |  216 lines
  1. MODULE Select;
  2.  
  3.  
  4. (*
  5.   © 1987, 1988 by Kevin Kelm ...
  6.     Public Domain... Free to all, not to be sold for profit.
  7.  
  8.   Written with TDI's Modula-2. (Ok, HAPPY guys!?! *)
  9.  
  10. *)
  11.  
  12.  
  13. FROM SYSTEM    IMPORT NULL, ADR, BYTE;
  14. FROM Libraries IMPORT OpenLibrary, CloseLibrary;
  15. FROM Intuition IMPORT NewWindow, WindowPtr, IntuitionBase, IntuitionName,
  16.     ScreenFlagSet, ScreenFlags, WindowFlagSet, WindowFlags, IDCMPFlagSet,
  17.     IDCMPFlags, SmartRefresh;
  18. FROM Pens            IMPORT SetAPen, SetBPen, Draw, Move, RectFill, SetDrMd;
  19. FROM Windows         IMPORT OpenWindow, CloseWindow;
  20. FROM GraphicsLibrary IMPORT GraphicsBase, GraphicsName, DrawingModeSet,
  21.     DrawingModes;
  22. FROM Text            IMPORT Text;
  23. FROM Rasters         IMPORT RastPort;
  24. FROM Strings         IMPORT Length;
  25. FROM CommandLine     IMPORT GetCL, CLStrings;
  26. FROM CIAHardware     IMPORT CIAA;
  27. FROM DOSLibrary IMPORT DOSName, DOSBase;
  28. FROM DOSCodeLoader IMPORT Execute;
  29.  
  30.  
  31. VAR window  : WindowPtr;
  32.   newWindow : NewWindow;
  33.   rp        : RastPort;
  34.   title, exstr     : ARRAY [0..109] OF CHAR;
  35.   i         : CARDINAL;
  36.   NOps      : CARDINAL;
  37.   ysize     : CARDINAL;
  38.   tnum      : CARDINAL;
  39.   argnum    : CARDINAL;
  40.   x, y      : CARDINAL;
  41.   Exit, ok  : BOOLEAN;
  42.   args      : ARRAY [0..14] OF CLStrings;
  43.  
  44.   str       : ARRAY [0..79] OF CHAR;
  45.   message1, message2   : ARRAY [0..130] OF CHAR;
  46.  
  47.  
  48. PROCEDURE OpenLibs () : BOOLEAN;
  49. BEGIN
  50.  IntuitionBase := OpenLibrary(IntuitionName,0);
  51.  IF IntuitionBase = 0 THEN
  52.        (* HEY! Who stole the *#$$#@! Intuition library?!?! *)
  53.   RETURN FALSE;
  54.  END (* if *);
  55.  
  56.  GraphicsBase := OpenLibrary(GraphicsName,0);
  57.  IF GraphicsBase = 0 THEN
  58.        (* WHAT?  An overdue Library File?! *)
  59.   CloseLibrary ( IntuitionBase );
  60.   RETURN FALSE;
  61.  END (* if *);
  62.  
  63.  RETURN TRUE;
  64.  
  65. END OpenLibs;
  66.  
  67.  
  68. PROCEDURE MakeWindow;
  69. BEGIN
  70.  title :=
  71. " Dneishe Start © 1987 by Kevin Kelm.                                             ";
  72.  WITH newWindow DO
  73.   LeftEdge := 0;  TopEdge := 0;
  74.   Width := 640;  Height := ysize;
  75.   DetailPen := BYTE(0);
  76.   BlockPen := BYTE(1);
  77.   Title := ADR(title);
  78.   Flags := WindowFlagSet{Activate} + SmartRefresh;
  79.   IDCMPFlags := IDCMPFlagSet{};
  80.   Type := ScreenFlagSet{WBenchScreen};
  81.   FirstGadget := NULL;
  82.   CheckMark := NULL;
  83.   Screen := NULL;
  84.   BitMap := NULL;
  85.   MinWidth := 0;  MinHeight := 0;
  86.   MaxWidth := 0;  MaxHeight := 0;
  87.  END (* with *);
  88.  
  89.  window := OpenWindow(newWindow);
  90.  rp := window^.RPort^;
  91.  
  92. END MakeWindow;
  93.  
  94.  
  95. PROCEDURE Gad ( x, y : CARDINAL; VAR s : ARRAY OF CHAR );
  96.  
  97. VAR len : CARDINAL;
  98. BEGIN
  99.  len := Length ( s );
  100.  IF len > 26 THEN
  101.   s[26] := 0C;
  102.   len := 25;
  103.  END (* if *);
  104.  
  105.  (* draw outline *)
  106.  SetAPen ( rp, 2 );
  107.  RectFill ( rp, x, y, x + 190, y + 15 );
  108.  SetAPen ( rp, 1 );
  109.  RectFill ( rp, x+3, y+1, x + 188, y + 14 );
  110.  SetAPen ( rp, 3 );
  111.  RectFill ( rp, x+5, y+2, x + 186, y + 13 );
  112.  
  113.  SetDrMd ( rp, DrawingModeSet { Jam2 } );
  114.  SetBPen ( rp, 3 );
  115.  SetAPen ( rp, 2 );
  116.  
  117.  Move ( rp, x + ( 190 - (len * 8 )) DIV 2,  y + 10 );
  118.  Text ( rp, s, len );
  119.  SetDrMd ( rp, DrawingModeSet {} );
  120.  SetBPen ( rp, 3 );
  121.  SetAPen ( rp, 1 );
  122.  
  123.  Move ( rp, x + ( 190 - (len * 8 )) DIV 2 - 1,  y + 11 );
  124.  Text ( rp, s, len );
  125.  
  126. END Gad;
  127.  
  128.  
  129. BEGIN
  130.  message1 := "Dneishe Start © 1987 by Kevin Kelm...'Dneishe' is simply a perversion of 'Nice,' and must be";
  131.  message2 := " pronounced with teeth clenched and a manic grin.";
  132.  
  133.  IF OpenLibs() THEN
  134.  
  135.   IF GetCL ( NOps, args ) THEN END;
  136.  
  137.   ysize := 50;
  138.  
  139.   IF NOps # 0 THEN
  140.    ysize := 67 + ((NOps-1) DIV 3 ) * 18;
  141.   END (* if *);
  142.  
  143.   MakeWindow;
  144.  
  145.   SetAPen ( rp, 2 );
  146.   RectFill ( rp, 2, 10, 636, ysize - 2 );
  147.  
  148.   SetAPen ( rp, 1 );
  149.   RectFill ( rp, 5, 11, 634, ysize - 3 );
  150.  
  151.   SetAPen ( rp, 2 );
  152.   SetBPen ( rp, 1 );
  153.   Move ( rp, 196, 19 );
  154.  
  155.   Text ( rp, "Please Select a Boot Sequence :", 31);
  156.  
  157.   Gad ( 223, 26, "CANCEL" );
  158.  
  159.   (* build `gadgets' *)
  160.   i := 0;
  161.   WHILE i < NOps DO
  162.    Gad ( 20 + (i MOD 3 ) * 203, 46 + (i DIV 3 ) * 18, args[i] );
  163.    INC ( i );
  164.   END (* while *);
  165.  
  166.   (* read `gadgets' *)
  167.  
  168.   argnum := 1000;
  169.   Exit := FALSE;
  170.  
  171.   WHILE NOT Exit DO
  172.    (* see if in a legal region *)
  173.    x := window^.MouseX; y := window^.MouseY;
  174.    (* check CANCEL button *)
  175.    IF (y > 26) AND (y < 42) THEN
  176.     IF (x > 223) AND (x < 412) AND NOT (6 IN CIAA.ciapra) THEN
  177.      tnum := 1000;
  178.      Exit := TRUE;
  179.     END (* if *);
  180.    ELSE
  181.  
  182.     tnum := ((y - 46) DIV 18) * 3 + (x-20) DIV 203;
  183.     IF ((x-20) MOD 203 > 189) OR ((y - 46) MOD 18 > 15) THEN
  184.      tnum := 1000;
  185.     END (* if *);
  186.     IF (tnum < NOps) AND NOT (6 IN CIAA.ciapra) THEN
  187.      Exit := TRUE;
  188.     END (* if *);
  189.    END (* if *);
  190.   END (* while *);
  191.  
  192.   CloseWindow ( window^ );
  193.  
  194.   DOSBase := OpenLibrary ( DOSName, 0);
  195.  
  196.   IF tnum # 1000 THEN
  197.    exstr := "Execute ";
  198.    FOR i := 0 TO Length ( args[tnum] ) DO
  199.     exstr[8 + i] := args[tnum][i];
  200.    END (* for *);
  201.    exstr[8+i] := 0C;
  202.    ok := Execute ( exstr, 0, 0 );
  203.   END (* if *);
  204.  
  205.   CloseLibrary(DOSBase);
  206.   CloseLibrary(GraphicsBase);
  207.   CloseLibrary(IntuitionBase);
  208.  
  209.  END (* if *);
  210.  
  211. END Select.
  212.  
  213.  
  214.  
  215.  
  216.